home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy-1.1 (sources only) / mindy-1.1 / interp / interp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-06-28  |  24.9 KB  |  1,100 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: interp.c,v 1.17 94/06/27 16:32:02 wlott Exp $
  27. *
  28. * This file implements the actual byte interpreter.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "mindy.h"
  33. #include "gc.h"
  34. #include "thread.h"
  35. #include "driver.h"
  36. #include "func.h"
  37. #include "bool.h"
  38. #include "list.h"
  39. #include "class.h"
  40. #include "obj.h"
  41. #include "module.h"
  42. #include "value.h"
  43. #include "num.h"
  44. #include "vec.h"
  45. #include "sym.h"
  46. #include "error.h"
  47. #include "type.h"
  48. #include "brkpt.h"
  49. #include "interp.h"
  50. #include "../comp/byteops.h"
  51.  
  52. obj_t obj_ComponentClass = 0;
  53.  
  54. static struct variable *plus_var = NULL;
  55. static struct variable *minus_var = NULL;
  56. static struct variable *lt_var = NULL;
  57. static struct variable *le_var = NULL;
  58. static struct variable *eq_var = NULL;
  59. static struct variable *ne_var = NULL;
  60.  
  61.  
  62. /* Various utility routines. */
  63.  
  64. inline static int decode_byte(struct thread *thread)
  65. {
  66.     return ((unsigned char *)(thread->component))[thread->pc++];
  67. }
  68.  
  69. inline static int decode_int4(struct thread *thread)
  70. {
  71.     int byte1 = decode_byte(thread);
  72.     int byte2 = decode_byte(thread);
  73.     int byte3 = decode_byte(thread);
  74.     int byte4 = decode_byte(thread);
  75.  
  76.     return byte1 | (byte2 << 8) | (byte3 << 16) | (byte4 << 24);
  77. }
  78.  
  79. inline static int decode_arg(struct thread *thread)
  80. {
  81.     int arg = decode_byte(thread);
  82.  
  83.     if (arg == 0xff)
  84.     return decode_int4(thread);
  85.     else
  86.     return arg;
  87. }
  88.  
  89. static void canonicalize_values(struct thread *thread, obj_t *old_sp,
  90.                 obj_t *vals)
  91. {
  92.     int supplied = thread->sp - vals;
  93.     int wants = decode_arg(thread);
  94.     int fixed;
  95.     boolean restp;
  96.     int i;
  97.  
  98.     fixed = wants >> 1;
  99.     restp = wants & 1;
  100.  
  101.     if (supplied <= fixed) {
  102.     if (old_sp != vals)
  103.         for (i = 0; i < supplied; i++)
  104.         *old_sp++ = *vals++;
  105.     else {
  106.         i = supplied;
  107.         old_sp += supplied;
  108.     }
  109.     while (i < fixed) {
  110.         *old_sp++ = obj_False;
  111.         i++;
  112.     }
  113.     if (restp)
  114.         *old_sp++ = make_vector(0, NULL);
  115.     }
  116.     else {
  117.     if (old_sp != vals)
  118.         for (i = 0; i < fixed; i++)
  119.         *old_sp++ = *vals++;
  120.     else
  121.         vals += fixed;
  122.     if (restp)
  123.         *old_sp++ = make_vector(supplied - fixed, vals);
  124.     }
  125.  
  126.     thread->sp = old_sp;
  127. }
  128.  
  129.  
  130.  
  131. /* Various byte ops. */
  132.  
  133. static void op_flame(int byte, struct thread *thread)
  134. {
  135.     lose("Bogus byte-op: %d", byte);
  136. }
  137.  
  138. static void op_breakpoint(int byte, struct thread *thread)
  139. {
  140.     handle_byte_breakpoint(thread);
  141. }
  142.  
  143. static void op_return_single(int byte, struct thread *thread)
  144. {
  145.     do_return(thread, pop_linkage(thread), thread->sp - 1);
  146. }
  147.  
  148. static void op_make_value_cell(int byte, struct thread *thread)
  149. {
  150.     thread->sp[-1] = make_value_cell(thread->sp[-1]);
  151. }
  152.  
  153. static void op_value_cell_ref(int byte, struct thread *thread)
  154. {
  155.     thread->sp[-1] = value_cell_ref(thread->sp[-1]);
  156. }
  157.  
  158. static void op_value_cell_set(int byte, struct thread *thread)
  159. {
  160.     obj_t *sp = thread->sp;
  161.     value_cell_set(sp[-1], sp[-2]);
  162.     thread->sp = sp - 2;
  163. }
  164.  
  165. static void op_make_method(int byte, struct thread *thread)
  166. {
  167.     obj_t *sp = thread->sp;
  168.     obj_t method_info = sp[-4];
  169.     obj_t specializers = sp[-3];
  170.     obj_t result_types = sp[-2];
  171.     obj_t rest_results_type = sp[-1];
  172.     int n_closure_vars
  173.     = obj_ptr(struct method_info *, method_info)->n_closure_vars;
  174.     obj_t *lexenv = sp - n_closure_vars - 4;
  175.     obj_t method = make_byte_method(method_info, specializers, result_types,
  176.                     rest_results_type, lexenv);
  177.  
  178.     lexenv[0] = method;
  179.     thread->sp = lexenv+1;
  180. }
  181.  
  182. static void op_check_type(int byte, struct thread *thread)
  183. {
  184.     obj_t *sp = thread->sp;
  185.     obj_t value = sp[-2];
  186.     obj_t type = sp[-1];
  187.  
  188.     if (!instancep(value, type))
  189.     type_error(value, type);
  190.  
  191.     thread->sp = sp - 1;
  192. }
  193.  
  194. static void op_check_type_function(int byte, struct thread *thread)
  195. {
  196.     if (!instancep(thread->sp[-1], obj_FunctionClass))
  197.     type_error(thread->sp[-1], obj_FunctionClass);
  198. }
  199.  
  200. static void op_canonicalize_value(int byte, struct thread *thread)
  201. {
  202.     obj_t *vals = thread->sp - 1;
  203.  
  204.     canonicalize_values(thread, vals, vals);
  205. }
  206.  
  207. static void op_push_byte(int byte, struct thread *thread)
  208. {
  209.     signed char value = decode_byte(thread);
  210.     *thread->sp++ = make_fixnum(value);
  211. }
  212.  
  213. static void op_push_int(int byte, struct thread *thread)
  214. {
  215.     *thread->sp++ = make_fixnum(decode_int4(thread));
  216. }
  217.  
  218. static void op_conditional_branch(int byte, struct thread *thread)
  219. {
  220.     if (*--thread->sp == obj_False) {
  221.     int disp = decode_int4(thread);
  222.     thread->pc += disp;
  223.     }
  224.     else
  225.     thread->pc += 4;
  226. }
  227.  
  228. static void op_branch(int byte, struct thread *thread)
  229. {
  230.     int disp = decode_int4(thread);
  231.     thread->pc += disp;
  232. }
  233.  
  234. static void op_push_nil(int byte, struct thread *thread)
  235. {
  236.     *thread->sp++ = obj_Nil;
  237. }
  238.  
  239. static void op_push_unbound(int byte, struct thread *thread)
  240. {
  241.     *thread->sp++ = obj_Unbound;
  242. }
  243.  
  244. static void op_push_true(int byte, struct thread *thread)
  245. {
  246.     *thread->sp++ = obj_True;
  247. }
  248.  
  249. static void op_push_false(int byte, struct thread *thread)
  250. {
  251.     *thread->sp++ = obj_False;
  252. }
  253.  
  254. static void op_dup(int byte, struct thread *thread)
  255. {
  256.     obj_t *sp = thread->sp;
  257.     obj_t value = sp[-1];
  258.  
  259.     thread->sp = sp+1;
  260.     sp[0] = value;
  261. }
  262.  
  263. static void op_dot_tail(int byte, struct thread *thread)
  264. {
  265.     obj_t *sp = thread->sp;
  266.     obj_t arg = sp[-2];
  267.     obj_t func = sp[-1];
  268.     obj_t *old_sp = pop_linkage(thread);
  269.  
  270.     old_sp[0] = func;
  271.     old_sp[1] = arg;
  272.     thread->sp = old_sp + 2;
  273.  
  274.     invoke(thread, 1);
  275. }
  276.  
  277. static void op_dot(int byte, struct thread *thread)
  278. {
  279.     obj_t *sp = thread->sp;
  280.     obj_t arg = sp[-2];
  281.     obj_t func = sp[-1];
  282.  
  283.     sp[-2] = func;
  284.     sp[-1] = arg;
  285.  
  286.     invoke(thread, 1);
  287. }    
  288.  
  289. static void push_constant(struct thread *thread, int arg)
  290. {
  291.     *thread->sp++
  292.     = COMPONENT(thread->component)->constant[arg];
  293. }
  294.  
  295. static void op_push_constant_immed(int byte, struct thread *thread)
  296. {
  297.     push_constant(thread, byte & 0x0f);
  298. }
  299.  
  300. static void op_push_constant(int byte, struct thread *thread)
  301. {
  302.     push_constant(thread, decode_arg(thread));
  303. }
  304.  
  305. static void push_arg(struct thread *thread, int arg)
  306. {
  307.     *thread->sp++ = thread->fp[-5 - arg];
  308. }
  309.  
  310. static void op_push_arg_immed(int byte, struct thread *thread)
  311. {
  312.     push_arg(thread, byte & 0x0f);
  313. }
  314.  
  315. static void op_push_arg(int byte, struct thread *thread)
  316. {
  317.     push_arg(thread, decode_arg(thread));
  318. }
  319.  
  320. static void pop_arg(struct thread *thread, int arg)
  321. {
  322.     thread->fp[-5 - arg] = *--thread->sp;
  323. }
  324.  
  325. static void op_pop_arg_immed(int byte, struct thread *thread)
  326. {
  327.     pop_arg(thread, byte & 0x0f);
  328. }
  329.  
  330. static void op_pop_arg(int byte, struct thread *thread)
  331. {
  332.     pop_arg(thread, decode_arg(thread));
  333. }
  334.  
  335. static void push_local(struct thread *thread, int arg)
  336. {
  337.     *thread->sp++ = thread->fp[arg];
  338. }
  339.  
  340. static void op_push_local_immed(int byte, struct thread *thread)
  341. {
  342.     push_local(thread, byte & 0x0f);
  343. }
  344.  
  345. static void op_push_local(int byte, struct thread *thread)
  346. {
  347.     push_local(thread, decode_arg(thread));
  348. }
  349.  
  350. static void pop_local(struct thread *thread, int arg)
  351. {
  352.     thread->fp[arg] = *--thread->sp;
  353. }
  354.  
  355. static void op_pop_local_immed(int byte, struct thread *thread)
  356. {
  357.     pop_local(thread, byte & 0x0f);
  358. }
  359.  
  360. static void op_pop_local(int byte, struct thread *thread)
  361. {
  362.     pop_local(thread, decode_arg(thread));
  363. }
  364.  
  365. static void call_tail(struct thread *thread, int arg)
  366. {
  367.     obj_t *sp = thread->sp;
  368.     obj_t *stuff = sp - arg - 1;
  369.     obj_t *old_sp = pop_linkage(thread);
  370.  
  371.     while (stuff < sp)
  372.     *old_sp++ = *stuff++;
  373.  
  374.     thread->sp = old_sp;
  375.  
  376.     invoke(thread, arg);
  377. }
  378.  
  379. static void op_call_tail_immed(int byte, struct thread *thread)
  380. {
  381.     call_tail(thread, byte & 0x0f);
  382. }
  383.  
  384. static void op_call_tail(int byte, struct thread *thread)
  385. {
  386.     call_tail(thread, decode_arg(thread));
  387. }
  388.  
  389. static void op_call_immed(int byte, struct thread *thread)
  390. {
  391.     invoke(thread, byte & 0x0f);
  392. }
  393.  
  394. static void op_call(int byte, struct thread *thread)
  395. {
  396.     int nargs = decode_arg(thread);
  397.     thread->pc++;
  398.     invoke(thread, nargs);
  399. }
  400.  
  401. static void push_value(struct thread *thread, int arg)
  402. {
  403.     struct variable *var
  404.     = (struct variable *)COMPONENT(thread->component)->constant[arg];
  405.     obj_t value = var->value;
  406.  
  407.     if (value != obj_Unbound)
  408.     *thread->sp++ = value;
  409.     else
  410.     error("Unbound variable: %=", var->name);
  411. }
  412.  
  413. static void op_push_value_immed(int byte, struct thread *thread)
  414. {
  415.     push_value(thread, byte & 0xf);
  416. }
  417.  
  418. static void op_push_value(int byte, struct thread *thread)
  419. {
  420.     push_value(thread, decode_arg(thread));
  421. }
  422.  
  423. static void push_function(struct thread *thread, int arg)
  424. {
  425.     struct variable *var
  426.     = (struct variable *)COMPONENT(thread->component)->constant[arg];
  427.     obj_t value = var->value;
  428.  
  429.     switch (var->function) {
  430.       case func_No:
  431.     type_error(value, obj_FunctionClass);
  432.       case func_Yes:
  433.       case func_Always:
  434.     break;
  435.       case func_Maybe:
  436.     if (instancep(value, obj_FunctionClass)) {
  437.         var->function = func_Yes;
  438.         break;
  439.     }
  440.     else if (value == obj_Unbound)
  441.         error("Unbound variable: %=", var->name);
  442.     else {
  443.         var->function = func_No;
  444.         type_error(value, obj_FunctionClass);
  445.     }
  446.     }
  447.  
  448.     *thread->sp++ = value;
  449. }
  450.  
  451. static void op_push_function_immed(int byte, struct thread *thread)
  452. {
  453.     push_function(thread, byte & 0xf);
  454. }
  455.  
  456. static void op_push_function(int byte, struct thread *thread)
  457. {
  458.     push_function(thread, decode_arg(thread));
  459. }
  460.  
  461. static void pop_value(struct thread *thread, int arg)
  462. {
  463.     struct variable *var
  464.     = (struct variable *)COMPONENT(thread->component)->constant[arg];
  465.     obj_t value = *--thread->sp;
  466.  
  467.     if (var->type != obj_False && !instancep(value, var->type))
  468.     type_error(value, var->type);
  469.     if (var->function != func_Always)
  470.     var->function = func_Maybe;
  471.     var->value = value;
  472. }
  473.  
  474. static void op_pop_value_immed(int byte, struct thread *thread)
  475. {
  476.     pop_value(thread, byte & 0xf);
  477. }
  478.  
  479. static void op_pop_value(int byte, struct thread *thread)
  480. {
  481.     pop_value(thread, decode_arg(thread));
  482. }
  483.  
  484. static void op_plus(int byte, struct thread *thread)
  485. {
  486.     obj_t *sp = thread->sp;
  487.     obj_t x = sp[-2];
  488.     obj_t y = sp[-1];
  489.  
  490.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  491.     sp[-2] = make_fixnum(fixnum_value(x) + fixnum_value(y));
  492.     thread->sp = sp-1;
  493.     }
  494.     else {
  495.     thread->sp = sp+1;
  496.     sp[-2] = plus_var->value;
  497.     sp[-1] = x;
  498.     sp[0] = y;
  499.     invoke(thread, 2);
  500.     }
  501. }
  502.  
  503. static void op_minus(int byte, struct thread *thread)
  504. {
  505.     obj_t *sp = thread->sp;
  506.     obj_t x = sp[-2];
  507.     obj_t y = sp[-1];
  508.  
  509.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  510.     sp[-2] = make_fixnum(fixnum_value(x) - fixnum_value(y));
  511.     thread->sp = sp-1;
  512.     }
  513.     else {
  514.     thread->sp = sp+1;
  515.     sp[-2] = minus_var->value;
  516.     sp[-1] = x;
  517.     sp[0] = y;
  518.     invoke(thread, 2);
  519.     }
  520. }
  521.  
  522. static void op_lt(int byte, struct thread *thread)
  523. {
  524.     obj_t *sp = thread->sp;
  525.     obj_t x = sp[-2];
  526.     obj_t y = sp[-1];
  527.  
  528.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  529.     sp[-2] = ((long)x < (long)y) ? obj_True : obj_False;
  530.     thread->sp = sp-1;
  531.     }
  532.     else {
  533.     thread->sp = sp+1;
  534.     sp[-2] = lt_var->value;
  535.     sp[-1] = x;
  536.     sp[0] = y;
  537.     invoke(thread, 2);
  538.     }
  539. }
  540.  
  541. static void op_le(int byte, struct thread *thread)
  542. {
  543.     obj_t *sp = thread->sp;
  544.     obj_t x = sp[-2];
  545.     obj_t y = sp[-1];
  546.  
  547.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  548.     sp[-2] = ((long)x <= (long)y) ? obj_True : obj_False;
  549.     thread->sp = sp-1;
  550.     }
  551.     else {
  552.     thread->sp = sp+1;
  553.     sp[-2] = le_var->value;
  554.     sp[-1] = x;
  555.     sp[0] = y;
  556.     invoke(thread, 2);
  557.     }
  558. }
  559.  
  560. static void op_eq(int byte, struct thread *thread)
  561. {
  562.     obj_t *sp = thread->sp;
  563.     obj_t x = sp[-2];
  564.     obj_t y = sp[-1];
  565.  
  566.     if (x == y) {
  567.     sp[-2] = obj_True;
  568.     thread->sp = sp-1;
  569.     }
  570.     else if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  571.     sp[-2] = obj_False;
  572.     thread->sp = sp-1;
  573.     }
  574.     else {
  575.     thread->sp = sp+1;
  576.     sp[-2] = eq_var->value;
  577.     sp[-1] = x;
  578.     sp[0] = y;
  579.     invoke(thread, 2);
  580.     }
  581. }
  582.  
  583. static void op_idp(int byte, struct thread *thread)
  584. {
  585.     obj_t *sp = thread->sp;
  586.     obj_t x = sp[-2];
  587.     obj_t y = sp[-1];
  588.  
  589.     if (x == y)
  590.     sp[-2] = obj_True;
  591.     else if (obj_is_fixnum(x) || obj_is_fixnum(y))
  592.     sp[-2] = obj_False;
  593.     else if (idp(x, y))
  594.     sp[-2] = obj_True;
  595.     else
  596.     sp[-2] = obj_False;
  597.  
  598.     thread->sp = sp-1;
  599. }
  600.  
  601. static void op_ne(int byte, struct thread *thread)
  602. {
  603.     obj_t *sp = thread->sp;
  604.     obj_t x = sp[-2];
  605.     obj_t y = sp[-1];
  606.  
  607.     if (x == y) {
  608.     sp[-2] = obj_False;
  609.     thread->sp = sp-1;
  610.     }
  611.     else if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  612.     sp[-2] = obj_True;
  613.     thread->sp = sp-1;
  614.     }
  615.     else {
  616.     thread->sp = sp+1;
  617.     sp[-2] = ne_var->value;
  618.     sp[-1] = x;
  619.     sp[0] = y;
  620.     invoke(thread, 2);
  621.     }
  622. }
  623.  
  624. static void op_ge(int byte, struct thread *thread)
  625. {
  626.     obj_t *sp = thread->sp;
  627.     obj_t x = sp[-2];
  628.     obj_t y = sp[-1];
  629.  
  630.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  631.     sp[-2] = ((long)x >= (long)y) ? obj_True : obj_False;
  632.     thread->sp = sp-1;
  633.     }
  634.     else {
  635.     thread->sp = sp+1;
  636.     sp[-2] = le_var->value;
  637.     /* sp[-1] already holds y */
  638.     sp[0] = x;
  639.     invoke(thread, 2);
  640.     }
  641. }
  642.  
  643. static void op_gt(int byte, struct thread *thread)
  644. {
  645.     obj_t *sp = thread->sp;
  646.     obj_t x = sp[-2];
  647.     obj_t y = sp[-1];
  648.  
  649.     if (obj_is_fixnum(x) && obj_is_fixnum(y)) {
  650.     sp[-2] = ((long)x > (long)y) ? obj_True : obj_False;
  651.     thread->sp = sp-1;
  652.     }
  653.     else {
  654.     thread->sp = sp+1;
  655.     sp[-2] = lt_var->value;
  656.     /* sp[-1] already holds y */
  657.     sp[0] = x;
  658.     invoke(thread, 2);
  659.     }
  660. }
  661.  
  662. void interpret_byte(int byte, struct thread *thread)
  663. {
  664.     switch (byte) {
  665.       case op_BREAKPOINT:
  666.     op_breakpoint(byte, thread);
  667.     break;
  668.       case op_RETURN_SINGLE:
  669.     op_return_single(byte, thread);
  670.     break;
  671.       case op_MAKE_VALUE_CELL:
  672.     op_make_value_cell(byte, thread);
  673.     break;
  674.       case op_VALUE_CELL_REF:
  675.     op_value_cell_ref(byte, thread);
  676.     break;
  677.       case op_VALUE_CELL_SET:
  678.     op_value_cell_set(byte, thread);
  679.     break;
  680.       case op_MAKE_METHOD:
  681.     op_make_method(byte, thread);
  682.     break;
  683.       case op_CHECK_TYPE:
  684.     op_check_type(byte, thread);
  685.     break;
  686.       case op_CHECK_TYPE_FUNCTION:
  687.     op_check_type_function(byte, thread);
  688.     break;
  689.       case op_CANONICALIZE_VALUE:
  690.     op_canonicalize_value(byte, thread);
  691.     break;
  692.       case op_PUSH_BYTE:
  693.     op_push_byte(byte, thread);
  694.     break;
  695.       case op_PUSH_INT:
  696.     op_push_int(byte, thread);
  697.     break;
  698.       case op_CONDITIONAL_BRANCH:
  699.     op_conditional_branch(byte, thread);
  700.     break;
  701.       case op_BRANCH:
  702.     op_branch(byte, thread);
  703.     break;
  704.       case op_PUSH_NIL:
  705.     op_push_nil(byte, thread);
  706.     break;
  707.       case op_PUSH_UNBOUND:
  708.     op_push_unbound(byte, thread);
  709.     break;
  710.       case op_PUSH_TRUE:
  711.     op_push_true(byte, thread);
  712.     break;
  713.       case op_PUSH_FALSE:
  714.     op_push_false(byte, thread);
  715.     break;
  716.       case op_DUP:
  717.     op_dup(byte, thread);
  718.     break;
  719.       case op_DOT_TAIL:
  720.     op_dot_tail(byte, thread);
  721.     break;
  722.       case op_DOT_FOR_SINGLE:
  723.       case op_DOT_FOR_MANY:
  724.     op_dot(byte, thread);
  725.     break;
  726.       case op_PUSH_CONSTANT|0:
  727.       case op_PUSH_CONSTANT|1:
  728.       case op_PUSH_CONSTANT|2:
  729.       case op_PUSH_CONSTANT|3:
  730.       case op_PUSH_CONSTANT|4:
  731.       case op_PUSH_CONSTANT|5:
  732.       case op_PUSH_CONSTANT|6:
  733.       case op_PUSH_CONSTANT|7:
  734.       case op_PUSH_CONSTANT|8:
  735.       case op_PUSH_CONSTANT|9:
  736.       case op_PUSH_CONSTANT|10:
  737.       case op_PUSH_CONSTANT|11:
  738.       case op_PUSH_CONSTANT|12:
  739.       case op_PUSH_CONSTANT|13:
  740.       case op_PUSH_CONSTANT|14:
  741.     op_push_constant_immed(byte, thread);
  742.     break;
  743.       case op_PUSH_CONSTANT|15:
  744.     op_push_constant(byte, thread);
  745.     break;
  746.       case op_PUSH_ARG|0:
  747.       case op_PUSH_ARG|1:
  748.       case op_PUSH_ARG|2:
  749.       case op_PUSH_ARG|3:
  750.       case op_PUSH_ARG|4:
  751.       case op_PUSH_ARG|5:
  752.       case op_PUSH_ARG|6:
  753.       case op_PUSH_ARG|7:
  754.       case op_PUSH_ARG|8:
  755.       case op_PUSH_ARG|9:
  756.       case op_PUSH_ARG|10:
  757.       case op_PUSH_ARG|11:
  758.       case op_PUSH_ARG|12:
  759.       case op_PUSH_ARG|13:
  760.       case op_PUSH_ARG|14:
  761.     op_push_arg_immed(byte, thread);
  762.     break;
  763.       case op_PUSH_ARG|15:
  764.     op_push_arg(byte, thread);
  765.     break;
  766.       case op_POP_ARG|0:
  767.       case op_POP_ARG|1:
  768.       case op_POP_ARG|2:
  769.       case op_POP_ARG|3:
  770.       case op_POP_ARG|4:
  771.       case op_POP_ARG|5:
  772.       case op_POP_ARG|6:
  773.       case op_POP_ARG|7:
  774.       case op_POP_ARG|8:
  775.       case op_POP_ARG|9:
  776.       case op_POP_ARG|10:
  777.       case op_POP_ARG|11:
  778.       case op_POP_ARG|12:
  779.       case op_POP_ARG|13:
  780.       case op_POP_ARG|14:
  781.     op_pop_arg_immed(byte, thread);
  782.     break;
  783.       case op_POP_ARG|15:
  784.     op_pop_arg(byte, thread);
  785.     break;
  786.       case op_PUSH_LOCAL|0:
  787.       case op_PUSH_LOCAL|1:
  788.       case op_PUSH_LOCAL|2:
  789.       case op_PUSH_LOCAL|3:
  790.       case op_PUSH_LOCAL|4:
  791.       case op_PUSH_LOCAL|5:
  792.       case op_PUSH_LOCAL|6:
  793.       case op_PUSH_LOCAL|7:
  794.       case op_PUSH_LOCAL|8:
  795.       case op_PUSH_LOCAL|9:
  796.       case op_PUSH_LOCAL|10:
  797.       case op_PUSH_LOCAL|11:
  798.       case op_PUSH_LOCAL|12:
  799.       case op_PUSH_LOCAL|13:
  800.       case op_PUSH_LOCAL|14:
  801.     op_push_local_immed(byte, thread);
  802.     break;
  803.       case op_PUSH_LOCAL|15:
  804.     op_push_local(byte, thread);
  805.     break;
  806.       case op_POP_LOCAL|0:
  807.       case op_POP_LOCAL|1:
  808.       case op_POP_LOCAL|2:
  809.       case op_POP_LOCAL|3:
  810.       case op_POP_LOCAL|4:
  811.       case op_POP_LOCAL|5:
  812.       case op_POP_LOCAL|6:
  813.       case op_POP_LOCAL|7:
  814.       case op_POP_LOCAL|8:
  815.       case op_POP_LOCAL|9:
  816.       case op_POP_LOCAL|10:
  817.       case op_POP_LOCAL|11:
  818.       case op_POP_LOCAL|12:
  819.       case op_POP_LOCAL|13:
  820.       case op_POP_LOCAL|14:
  821.     op_pop_local_immed(byte, thread);
  822.     break;
  823.       case op_POP_LOCAL|15:
  824.     op_pop_local(byte, thread);
  825.     break;
  826.       case op_CALL_TAIL|0:
  827.       case op_CALL_TAIL|1:
  828.       case op_CALL_TAIL|2:
  829.       case op_CALL_TAIL|3:
  830.       case op_CALL_TAIL|4:
  831.       case op_CALL_TAIL|5:
  832.       case op_CALL_TAIL|6:
  833.       case op_CALL_TAIL|7:
  834.       case op_CALL_TAIL|8:
  835.       case op_CALL_TAIL|9:
  836.       case op_CALL_TAIL|10:
  837.       case op_CALL_TAIL|11:
  838.       case op_CALL_TAIL|12:
  839.       case op_CALL_TAIL|13:
  840.       case op_CALL_TAIL|14:
  841.     op_call_tail_immed(byte, thread);
  842.     break;
  843.       case op_CALL_TAIL|15:
  844.     op_call_tail(byte, thread);
  845.     break;
  846.       case op_CALL_FOR_MANY|0:
  847.       case op_CALL_FOR_MANY|1:
  848.       case op_CALL_FOR_MANY|2:
  849.       case op_CALL_FOR_MANY|3:
  850.       case op_CALL_FOR_MANY|4:
  851.       case op_CALL_FOR_MANY|5:
  852.       case op_CALL_FOR_MANY|6:
  853.       case op_CALL_FOR_MANY|7:
  854.       case op_CALL_FOR_MANY|8:
  855.       case op_CALL_FOR_MANY|9:
  856.       case op_CALL_FOR_MANY|10:
  857.       case op_CALL_FOR_MANY|11:
  858.       case op_CALL_FOR_MANY|12:
  859.       case op_CALL_FOR_MANY|13:
  860.       case op_CALL_FOR_MANY|14:
  861.       case op_CALL_FOR_SINGLE|0:
  862.       case op_CALL_FOR_SINGLE|1:
  863.       case op_CALL_FOR_SINGLE|2:
  864.       case op_CALL_FOR_SINGLE|3:
  865.       case op_CALL_FOR_SINGLE|4:
  866.       case op_CALL_FOR_SINGLE|5:
  867.       case op_CALL_FOR_SINGLE|6:
  868.       case op_CALL_FOR_SINGLE|7:
  869.       case op_CALL_FOR_SINGLE|8:
  870.       case op_CALL_FOR_SINGLE|9:
  871.       case op_CALL_FOR_SINGLE|10:
  872.       case op_CALL_FOR_SINGLE|11:
  873.       case op_CALL_FOR_SINGLE|12:
  874.       case op_CALL_FOR_SINGLE|13:
  875.       case op_CALL_FOR_SINGLE|14:
  876.     op_call_immed(byte, thread);
  877.     break;
  878.       case op_CALL_FOR_MANY|15:
  879.       case op_CALL_FOR_SINGLE|15:
  880.     op_call(byte, thread);
  881.     break;
  882.       case op_PUSH_VALUE|0:
  883.       case op_PUSH_VALUE|1:
  884.       case op_PUSH_VALUE|2:
  885.       case op_PUSH_VALUE|3:
  886.       case op_PUSH_VALUE|4:
  887.       case op_PUSH_VALUE|5:
  888.       case op_PUSH_VALUE|6:
  889.       case op_PUSH_VALUE|7:
  890.       case op_PUSH_VALUE|8:
  891.       case op_PUSH_VALUE|9:
  892.       case op_PUSH_VALUE|10:
  893.       case op_PUSH_VALUE|11:
  894.       case op_PUSH_VALUE|12:
  895.       case op_PUSH_VALUE|13:
  896.       case op_PUSH_VALUE|14:
  897.     op_push_value_immed(byte, thread);
  898.     break;
  899.       case op_PUSH_VALUE|15:
  900.     op_push_value(byte, thread);
  901.     break;
  902.       case op_PUSH_FUNCTION|0:
  903.       case op_PUSH_FUNCTION|1:
  904.       case op_PUSH_FUNCTION|2:
  905.       case op_PUSH_FUNCTION|3:
  906.       case op_PUSH_FUNCTION|4:
  907.       case op_PUSH_FUNCTION|5:
  908.       case op_PUSH_FUNCTION|6:
  909.       case op_PUSH_FUNCTION|7:
  910.       case op_PUSH_FUNCTION|8:
  911.       case op_PUSH_FUNCTION|9:
  912.       case op_PUSH_FUNCTION|10:
  913.       case op_PUSH_FUNCTION|11:
  914.       case op_PUSH_FUNCTION|12:
  915.       case op_PUSH_FUNCTION|13:
  916.       case op_PUSH_FUNCTION|14:
  917.     op_push_function_immed(byte, thread);
  918.     break;
  919.       case op_PUSH_FUNCTION|15:
  920.     op_push_function(byte, thread);
  921.     break;
  922.       case op_POP_VALUE|0:
  923.       case op_POP_VALUE|1:
  924.       case op_POP_VALUE|2:
  925.       case op_POP_VALUE|3:
  926.       case op_POP_VALUE|4:
  927.       case op_POP_VALUE|5:
  928.       case op_POP_VALUE|6:
  929.       case op_POP_VALUE|7:
  930.       case op_POP_VALUE|8:
  931.       case op_POP_VALUE|9:
  932.       case op_POP_VALUE|10:
  933.       case op_POP_VALUE|11:
  934.       case op_POP_VALUE|12:
  935.       case op_POP_VALUE|13:
  936.       case op_POP_VALUE|14:
  937.     op_pop_value_immed(byte, thread);
  938.     break;
  939.       case op_POP_VALUE|15:
  940.     op_pop_value(byte, thread);
  941.     break;
  942.       case op_PLUS:
  943.     op_plus(byte, thread);
  944.     break;
  945.       case op_MINUS:
  946.     op_minus(byte, thread);
  947.     break;
  948.       case op_LT:
  949.     op_lt(byte, thread);
  950.     break;
  951.       case op_LE:
  952.     op_le(byte, thread);
  953.     break;
  954.       case op_EQ:
  955.     op_eq(byte, thread);
  956.     break;
  957.       case op_IDP:
  958.     op_idp(byte, thread);
  959.     break;
  960.       case op_NE:
  961.     op_ne(byte, thread);
  962.     break;
  963.       case op_GE:
  964.     op_ge(byte, thread);
  965.     break;
  966.       case op_GT:
  967.     op_gt(byte, thread);
  968.     break;
  969.       default:
  970.     op_flame(byte, thread);
  971.     }
  972. }
  973.  
  974. void interpret_next_byte(struct thread *thread)
  975. {
  976.     interpret_byte(decode_byte(thread), thread);
  977. }
  978.  
  979.  
  980.  
  981. /* Entry points into the interpteter. */
  982.  
  983. void set_byte_continuation(struct thread *thread, obj_t component)
  984. {
  985.     int n_const = COMPONENT(component)->n_constants;
  986.     thread->component = component;
  987.     thread->pc = (char *)(&COMPONENT(component)->constant[n_const])
  988.     - (char *)component;
  989.     thread->sp = thread->fp + COMPONENT(component)->frame_size;
  990. #if SLOW_FUNCTION_POINTERS
  991.     thread->advance = NULL;
  992. #else
  993.     thread->advance = interpret_next_byte;
  994. #endif    
  995. }
  996.  
  997. void do_byte_return(struct thread *thread, obj_t *old_sp, obj_t *vals)
  998. {
  999.     int opcode = ((unsigned char *)(thread->component))[thread->pc - 1];
  1000.  
  1001.     if (opcode == op_BREAKPOINT)
  1002.     opcode = original_byte(thread->component, thread->pc - 1);
  1003.  
  1004.     if ((opcode&0xf0) == op_CALL_FOR_SINGLE || opcode == op_DOT_FOR_SINGLE
  1005.       || opcode >= op_PLUS) {
  1006.     if (vals == thread->sp)
  1007.         *old_sp = obj_False;
  1008.     else if (vals != old_sp)
  1009.         *old_sp = vals[0];
  1010.     thread->sp = old_sp + 1;
  1011.     }
  1012.     else if ((opcode&0xf0) == op_CALL_FOR_MANY || opcode == op_DOT_FOR_MANY)
  1013.     canonicalize_values(thread, old_sp, vals);
  1014.     else
  1015.     lose("Strange call opcode: 0x%02x", opcode);
  1016.  
  1017. #if SLOW_FUNCTION_POINTERS
  1018.     thread->advance = NULL;
  1019. #else
  1020.     thread->advance = interpret_next_byte;
  1021. #endif
  1022. }
  1023.  
  1024.  
  1025. /* Component allocation. */
  1026.  
  1027. obj_t make_component(obj_t debug_name, int frame_size, obj_t mtime,
  1028.              obj_t source_file, obj_t debug_info, int nconst,
  1029.              int nbytes)
  1030. {
  1031.     int len = sizeof(struct component) + sizeof(obj_t)*nconst + nbytes;
  1032.     obj_t res = alloc(obj_ComponentClass, len);
  1033.     int i;
  1034.  
  1035.     COMPONENT(res)->length = len;
  1036.     COMPONENT(res)->debug_name = debug_name;
  1037.     COMPONENT(res)->frame_size = frame_size;
  1038.     COMPONENT(res)->mtime = mtime;
  1039.     COMPONENT(res)->source_file = source_file;
  1040.     COMPONENT(res)->debug_info = debug_info;
  1041.     COMPONENT(res)->n_constants = nconst;
  1042.  
  1043.     for (i = 0; i < nconst; i++)
  1044.     COMPONENT(res)->constant[i] = obj_Unbound;
  1045.  
  1046.     return res;
  1047. }
  1048.  
  1049.  
  1050. /* GC routines. */
  1051.  
  1052. static int scav_component(struct object *ptr)
  1053. {
  1054.     struct component *component = (struct component *)ptr;
  1055.     int i;
  1056.  
  1057.     scavenge(&component->debug_name);
  1058.     scavenge(&component->mtime);
  1059.     scavenge(&component->source_file);
  1060.     scavenge(&component->debug_info);
  1061.     for (i = 0; i < component->n_constants; i++)
  1062.     scavenge(component->constant + i);
  1063.  
  1064.     return component->length;
  1065. }
  1066.  
  1067. static obj_t trans_component(obj_t component)
  1068. {
  1069.     return transport(component, COMPONENT(component)->length);
  1070. }
  1071.  
  1072. void scavenge_interp_roots(void)
  1073. {
  1074.     scavenge(&obj_ComponentClass);
  1075. }
  1076.  
  1077.  
  1078. /* Init stuff. */
  1079.  
  1080. void make_interp_classes(void)
  1081. {
  1082.     obj_ComponentClass = make_builtin_class(scav_component, trans_component);
  1083. }
  1084.  
  1085. void init_interp_classes(void)
  1086. {
  1087.     init_builtin_class(obj_ComponentClass, "<component>",
  1088.                obj_ObjectClass, NULL);
  1089. }
  1090.  
  1091. void init_interpreter(void)
  1092. {
  1093.     plus_var = find_variable(module_BuiltinStuff, symbol("+"), FALSE, TRUE);
  1094.     minus_var = find_variable(module_BuiltinStuff, symbol("-"), FALSE, TRUE);
  1095.     lt_var = find_variable(module_BuiltinStuff, symbol("<"), FALSE, TRUE);
  1096.     le_var = find_variable(module_BuiltinStuff, symbol("<="), FALSE, TRUE);
  1097.     eq_var = find_variable(module_BuiltinStuff, symbol("="), FALSE, TRUE);
  1098.     ne_var = find_variable(module_BuiltinStuff, symbol("~="), FALSE, TRUE);
  1099. }
  1100.